unit QBDbiWindow;
{$I QBuilderVerCtrl.inc}
interface

uses
  {$IFDEF VCL16}
    System.Classes,
    System.SysUtils,
  {$ELSE}
    Classes,
    SysUtils,
  {$ENDIF}
  QBWindow,
  QBParser,
  QBStringTypes;

const
  DbiSQLKeywords = 'ABS,ACOS,ADD,ALL,ALLTRIM,ALTER,AND,AS,ASC,ASCENDING,' +
    'ASIN,AT,ATAN,ATAN2,AUTOINC,BETWEEN,BINARY,BIT,BLOB,BLOCK,BOOL,' +
    'BOOLEAN,BOTH,BY,BYTES,CAST,CEIL,CEILING,CHAR,CHARACTER,CHARCASE,' +
    'CHARS,COALESCE,COLUMN,COLUMNS,COMMIT,COMPRESS,CONCAT,CONSTRAINT,' +
    'COS,COT,CREATE,CURRENT_DATE,CURRENT_GUID,CURRENT_TIME,' +
    'CURRENT_TIMESTAMP,DAY,DAYOFWEEK,DAYOFYEAR,DAYSFROMMSECS,DECIMAL,' +
    'DEFAULT,DEGREES,DELETE,DELIMITER,DESC,DESCENDING,DESCRIPTION,' +
    'DISTINCT,DROP,DUPBYTE,ELSE,EMPTY,ENCRYPTED,ESCAPE,EXISTS,EXP,' +
    'EXPORT,EXTRACT,FALSE,FLOAT,FLOOR,FLUSH,FOR,FORCEINDEXREBUILD,' +
    'FROM,FULL,GRAPHIC,GROUP,GUID,HAVING,HEADERS,HOUR,HOURSFROMMSECS,' +
    'IDENT_CURRENT,IDENTITY,IF,IFNULL,IMPORT,IN,INCLUDE,INDEX,' +
    'INNER,INSERT,INT,INTEGER,INTERVAL,INTO,IS,JOIN,KEY,LARGEINT,' +
    'LAST,LASTAUTOINC,LCASE,LEADING,LEFT,LENGTH,LIKE,LOCALE,LOG,LOG10,' +
    'LONGVARBINARY,LONGVARCHAR,LOWER,LTRIM,MAJOR,MAXIMUM,MEMO,' +
    'MINIMUM,MINOR,MINSFROMMSECS,MINUTE,MOD,MONEY,MONTH,MSECOND,' +
    'MSECSFROMMSECS,NOBACKUP,NOCASE,NOCHANGE,NOJOINOPTIMIZE,NONE,' +
    'NOT,NULL,NUMERIC,OCCURS,ON,OPTIMIZE,OR,ORDER,OUTER,PAGE,PI,POS,' +
    'POSITION,POWER,PRIMARY,RADIANS,RAND,RANGE,REDEFINE,RENAME,REPAIR,' +
    'REPEAT,REPLACE,RIGHT,ROLLBACK,ROUND,RTRIM,SECOND,SECSFROMMSECS,' +
    'SELECT,SET,SIGN,SIN,SIZE,SMALLINT,SPACE,SQRT,START,STOP,SUBSTRING,' +
    'TABLE,TAN,TEXT,TEXTOCCURS,TEXTSEARCH,THEN,TIME,TIMESTAMP,TO,TOP,' +
    'TRAILBYTE,TRAILING,TRANSACTION,TRIM,TRUE,TRUNC,TRUNCATE,UCASE,UNION,' +
    'UNIQUE,UPDATE,UPGRADE,UPPER,USER,VALUES,VARBINARY,VARBYTES,VARCHAR,' +
    'VERIFY,VERSION,WEEK,WHERE,WITH,WORD,WORDS,WORK,YEAR,YEARSFROMMSECS';

  DbiSQLFunctions = 'LOWER,LCASE,UPPER,UCASE,LENGTH,SUBSTRING,LEFT,' +
    'RIGHT,TRIM,LTRIM,RTRIM,POS,POSITION,OCCURS,REPLACE,REPEAT,CONCAT,' +
    'ABS,ACOS,ASIN,ATAN,ATAN2,CEIL,CEILING,COS,COT,DEGREES,EXP,FLOOR,LOG,' +
    'LOG10,MOD,PI,POWER,RADIANS,RAND,ROUND,SIGN,SIN,SQRT,TAN,TRUNC,' +
    'TRUNCATE,IF,IFNULL,COALESCE,TEXTSEARCH,TEXTOCCURS,EXTRACT,' +
    'CAST,YEARSFROMMSECS,DAYSFROMMSECS,HOURSFROMMSECS,MINSFROMMSECS,' +
    'SECSFROMMSECS,MSECSFROMMSECS,AVG,COUNT,MAX,MIN,SUM,RUNSUM';

  DbiSQLAggregates = 'AVG,COUNT,MAX,MIN,SUM,RUNSUM';

type

  TQBDbiSQLOptions = class(TPersistent)
  private
    FParser: TQBSelectParser;
    function GetOptionsScript: aqbString;
  public
    constructor Create(AParser: TQBSelectParser);
    procedure Assign(Source: TPersistent); override;
    procedure Clear;

    property OptionsScript: aqbString read GetOptionsScript;
    property Parser: TQBSelectParser read FParser;
  end;

  TQBDbiSQLScanner = class(TQBSQLScanner)
  protected
    function IsQuote(Ch: aqbChar): boolean; override;
    function GetIdentQuote: aqbChar; override;
    function GetProcessAliases: boolean; override;
    function GetQuoteIdentifiers: boolean; override;
    function GetCommaKeywords: aqbString; override;
    function GetCommaFunctions: aqbString; override;
    procedure DefineBooleans; override;
  public
    function IsIdentQuote(Ch: aqbChar): boolean; override;
    function NeedQuotes(const Ident: aqbString): boolean; override;
  end;

  TQBDbiSelectParser = class(TQBSelectParser)
  private
    FDbiSQLOptions: TQBDbiSQLOptions;
    procedure SetDbiSQLOptions(const Value: TQBDbiSQLOptions);
  protected
    function CreateScanner: TQBSQLScanner; override;
    function GetCommaAggregates: aqbString; override;
    function GetExpression: aqbString; override;
    procedure DoParseOptions; virtual;
    procedure DoParseAppendix; override;
    function GetCaseSensitiveIdentifiers: boolean; override;
  public
    constructor Create(AParent: TPersistent); override;
    destructor Destroy; override;
    procedure Clear; override;
    property DbiSQLOptions: TQBDbiSQLOptions read FDbiSQLOptions write
      SetDbiSQLOptions;
  end;

  TDbiQueryBuilder = class(TFullQueryBuilder {TCustomQueryBuilder})
  public
    function CreateParser(AParent: TPersistent): TQBSelectParser; override;
  published
    property About;
    property Align;
    property Aggregates;
    property Functions;
    property Keywords;
    property Operators;
    property Options;
    property Palette;
    property QuoteIdentifiers default True;
    property ScriptFormat;
    property Storage;
    property Style;
    property TabHeight;
    property VisibleTabs;
    property _Version;
    // ayz
    property WorkAreaPopupMenu;
    property TabsPopupMenu;
    // \ayz

    property OnStartDrag;
    property OnDragOver;
    property OnDragDrop;
    property OnEndDrag;
    {$IFNDEF EC_UNICODE}
    property OnGetTableFields;
    property OnParserError;
    {$ELSE}
    property OnGetTableFieldsW;
    property OnParserErrorW;
    {$ENDIF}
    property OnAddRemoveTable;
    property OnAddRemoveLink;
    property OnEnterProcParameter;
  end;

implementation

const
  sSelect = 'SELECT';
  sLimit = 'LIMIT';
  sDistinct = 'DISTINCT';
  sAll = 'ALL';

  { TQBDbiSQLScanner }

procedure TQBDbiSQLScanner.DefineBooleans;
begin
  Booleans[False] := 'FALSE';
  Booleans[True] := 'TRUE';
end;

function TQBDbiSQLScanner.GetCommaFunctions: aqbString;
begin
  Result := DbiSQLFunctions;
end;

function TQBDbiSQLScanner.GetCommaKeywords: aqbString;
begin
  Result := DbiSQLKeywords;
end;

function TQBDbiSQLScanner.GetIdentQuote: aqbChar;
begin
  Result := '"';
end;

function TQBDbiSQLScanner.GetProcessAliases: boolean;
begin
  Result := QuoteIdentifiers;
end;

function TQBDbiSQLScanner.GetQuoteIdentifiers: boolean;
begin
  Result := true;
end;

function TQBDbiSQLScanner.IsIdentQuote(Ch: aqbChar): boolean;
begin
  Result := Ch = '"';
end;

function TQBDbiSQLScanner.IsQuote(Ch: aqbChar): boolean;
begin
  Result := Ch = '''';
end;

function TQBDbiSQLScanner.NeedQuotes(const Ident: aqbString): boolean;
begin
  if (Length(Ident) > 1) and IsIdentQuote(Ident[1]) and
    IsIdentQuote(Ident[Length(Ident)]) then
    Result := false
  else
    Result := inherited NeedQuotes(Ident);
end;

{ TQBDbiSelectParser }

procedure TQBDbiSelectParser.Clear;
begin
  inherited;
  FDbiSQLOptions.Clear;
end;

constructor TQBDbiSelectParser.Create(AParent: TPersistent);
begin
  inherited Create(AParent);
  FDbiSQLOptions := TQBDbiSQLOptions.Create(Self);
end;

function TQBDbiSelectParser.CreateScanner: TQBSQLScanner;
begin
  Result := TQBDbiSQLScanner.Create;
end;

destructor TQBDbiSelectParser.Destroy;
begin
  FDbiSQLOptions.Free;
  inherited;
end;

procedure TQBDbiSelectParser.DoParseAppendix;
begin
  inherited;
end;

procedure TQBDbiSelectParser.DoParseOptions;
begin
  //
end;

function TQBDbiSelectParser.GetCaseSensitiveIdentifiers: boolean;
begin
  Result := false;
end;

function TQBDbiSelectParser.GetCommaAggregates: aqbString;
begin
  Result := DbiSQLAggregates;
end;

function TQBDbiSelectParser.GetExpression: aqbString;

  function GetDistinctStr: aqbString;
  begin
    if Distinct then
      Result := ' ' + ProcessKeyword('DISTINCT')
    else
      Result := '';
  end;

begin
  Result := TableDefs.Script;
  if Result <> '' then
    case TypeQuery of
      tqSelect: Result := ProcessKeyWord(sSelect) + GetDistinctStr +
        ' ' + FDbiSQLOptions.OptionsScript + Result + WhereItems.Script +
          GroupByItems.Script + HavingItems.Script + OrderByItems.Script;
      tqInsert: Result := ProcessKeyword('INSERT') + ' ' + ProcessKeyword('INTO') +
        Result + ValuesItems.Script;
      tqUpdate: Result := ProcessKeyWord('UPDATE') + ' ' + Result + WhereItems.Script;
      tqDelete: Result := ProcessKeyWord('DELETE') + ' ' + Result + WhereItems.Script;
    end;
end;

procedure TQBDbiSelectParser.SetDbiSQLOptions(const Value: TQBDbiSQLOptions);
begin
  if FDbiSQLOptions <> Value then
    FDbiSQLOptions.Assign(Value);
end;

{ TDbiQueryBuilder }

function TDbiQueryBuilder.CreateParser(AParent: TPersistent): TQBSelectParser;
begin
  Result := TQBDbiSelectParser.Create(AParent);
end;

{ TQBDbiSQLOptions }

procedure TQBDbiSQLOptions.Assign(Source: TPersistent);
begin
  if Source is TQBDbiSQLOptions then
  begin
  end
  else
    inherited;
end;

procedure TQBDbiSQLOptions.Clear;
begin
  //
end;

constructor TQBDbiSQLOptions.Create(AParser: TQBSelectParser);
begin
  inherited Create;
  FParser := AParser;
end;

function TQBDbiSQLOptions.GetOptionsScript: aqbString;
begin
  Result := '';
end;

end.
